problema3-checkpoint2

emendas.areas.parlamentar <- read.csv("emendas_area_parlamentar.csv")

Vamos inicialmente ver quais dados temos:

emendas.areas.parlamentar %>% head()

##                NOME_PARLAMENTAR Agricultura Assistência.Social
## 1 ABEL SALVADOR MESQUITA JUNIOR           0               0.00
## 2            ABELARDO CAMARINHA           0           11665.61
## 3               ABELARDO LUPION           0          206073.89
## 4            ABERLADO CAMARINHA           0               0.00
## 5                  ACELINO POPO           0          925698.77
## 6                  ACIR GURGACZ           0           88947.00
##   Ciência.e.Tecnologia Comércio.e.Serviços  Cultura Defesa.Nacional
## 1                  0.0                0.00     0.00          3000.0
## 2             234296.3                0.00     0.00             0.0
## 3                  0.0            12500.00 12500.00             0.0
## 4                  0.0                0.00     0.00             0.0
## 5                  0.0            44556.25 44556.25             0.0
## 6                  0.0                0.00     0.00        920420.5
##   Desporto.e.Lazer Direitos.da.Cidadania Gestão.Ambiental Indústria
## 1              0.0                     0              0.0       0.0
## 2              0.0                     0         234296.3  234296.3
## 3              0.0                     0              0.0       0.0
## 4              0.0                     0              0.0       0.0
## 5         252265.2                     0              0.0       0.0
## 6              0.0                     0              0.0       0.0
##   Organização.Agrária Outros Saneamento   Saúde Segurança.Pública Trabalho
## 1                 0.0   3929       0.00    0.00                 0        0
## 2                 0.0      0 1274496.28    0.00                 0        0
## 3            184792.6      0  132487.12    0.00                 0        0
## 4                 0.0      0   70769.45    0.00                 0        0
## 5            925698.8      0 1546956.55    0.00                 0        0
## 6             88947.0      0       0.00 1200.53                 0        0
##    Urbanismo
## 1       0.00
## 2 1508792.58
## 3  132487.12
## 4   70769.45
## 5 1546956.55
## 6       0.00

Vemos que cada observação é um parlamentar, onde a primeira coluna é o nome do mesmo, e as demais representam o investimento total que ele fez na área especificada.

Vamos ver como se comportam os dados das áreas:

melted.emendas.areas.parlamentar <- melt(emendas.areas.parlamentar, id=c("NOME_PARLAMENTAR")) 

ggplot(melted.emendas.areas.parlamentar, aes(value)) +
  geom_histogram() +
  facet_wrap(~variable)

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

Como vemos, os dados são bastante enviesados, logo iremos utilizar a função log em cima dos mesmos:

melted.emendas.areas.parlamentar <- melted.emendas.areas.parlamentar %>%
  mutate(
    log.value = log(value)
  )

ggplot(melted.emendas.areas.parlamentar, aes(log.value)) +
  geom_histogram() +
  facet_wrap(~variable, scales = "free")

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

## Warning: Removed 9877 rows containing non-finite values (stat_bin).

Grande parte dos dados parecem seguir uma distribuição normal, ou pelo menos próximo de uma normal.

Vamos remover os valores infinitos gerados pelo log:

melted.emendas.areas.parlamentar <- melted.emendas.areas.parlamentar %>%
  mutate(
    non.infinite.log.value = ifelse(is.infinite(log.value), 0, log.value)
  )

emendas.area.2 <- dcast(select(melted.emendas.areas.parlamentar, -value, -log.value), NOME_PARLAMENTAR ~ variable)

## Using non.infinite.log.value as value column: use value.var to override.

emendas.area.2 <- emendas.area.2 %>%
  filter(!is.na(NOME_PARLAMENTAR))

row.names(emendas.area.2) <- as.character(emendas.area.2$NOME_PARLAMENTAR)

Agora vamos reduzir a dimensão dos dados utilizando a técnica PCA:

principal.components <- prcomp(select(emendas.area.2, -NOME_PARLAMENTAR), scale = TRUE)
#kable(principal.components$rotation)
#biplot(principal.components, scale = 0)

#autoplot(principal.components, label = TRUE, label.size = 3, shape = FALSE)

autoplot(principal.components, label = TRUE, label.size = 3, shape = FALSE, 
         loadings = TRUE, loadings.colour = 'blue',
         loadings.label = TRUE, loadings.label.size = 4)

Para melhorar a visualização dos vetores que representam as variáveis vamos retirar os nomes dos parlamentares:

autoplot(principal.components, shape = TRUE, 
         loadings = TRUE, loadings.colour = 'blue',
         loadings.label = TRUE, loadings.label.size = 4)

Vemos 3 sentidos mais gerais em que os vetores apontam:

• O sentido de defesa nacional
• O sentido próximo de gestão ambiental
• O sentido próximo de agricultura

Além disso, conseguimos perceber 2 grandes grupos, um que tem valores de gestão ambiental, indústria e ciência e tecnologia mais altos e o outro são os demais, que estão mais condensados.

Vamos ver qual a porcentagem da variância explicada quando reduzimos as dimensões:

plot_pve <- function(prout){
  pr.var <- prout$sdev ** 2
  pve <- pr.var / sum(pr.var)
  df = data.frame(x = 1:NROW(pve), y = cumsum(pve))
  ggplot(df, aes(x = x, y = y)) + 
    geom_point(size = 3) + 
    geom_line() + 
    labs(x='Principal Component', y = 'Cumulative Proportion of Variance Explained')
}

plot_pve(principal.components)

Vemos que infelizmente ao reduzir a apenas 2 dimensões perdemos significativamente variância do dado original, visto que ficamos com pouco mais de 20%. Porém como o intuito também é agrupar os parlamentares, o ideal é que a redução seja a 2 dimensões.

Agora vamos reduzir as dimensões utilizando outra técnica chamada t-SNE:

tsne.dim = Rtsne(select(emendas.area.2, -NOME_PARLAMENTAR), 
                 verbose = TRUE, 
                 check_duplicates = FALSE,
                 scale = TRUE)

## Read the 861 x 17 data matrix successfully!
## Using no_dims = 2, perplexity = 30.000000, and theta = 0.500000
## Computing input similarities...
## Normalizing input...
## Building tree...
##  - point 0 of 861
## Done in 0.12 seconds (sparsity = 0.143312)!
## Learning embedding...
## Iteration 50: error is 66.672004 (50 iterations in 0.39 seconds)
## Iteration 100: error is 62.935223 (50 iterations in 0.29 seconds)
## Iteration 150: error is 62.563264 (50 iterations in 0.30 seconds)
## Iteration 200: error is 62.500102 (50 iterations in 0.30 seconds)
## Iteration 250: error is 62.467622 (50 iterations in 0.29 seconds)
## Iteration 300: error is 0.781399 (50 iterations in 0.27 seconds)
## Iteration 350: error is 0.646534 (50 iterations in 0.28 seconds)
## Iteration 400: error is 0.612672 (50 iterations in 0.28 seconds)
## Iteration 450: error is 0.595451 (50 iterations in 0.28 seconds)
## Iteration 500: error is 0.590765 (50 iterations in 0.28 seconds)
## Iteration 550: error is 0.585186 (50 iterations in 0.28 seconds)
## Iteration 600: error is 0.580898 (50 iterations in 0.28 seconds)
## Iteration 650: error is 0.579417 (50 iterations in 0.28 seconds)
## Iteration 700: error is 0.578162 (50 iterations in 0.28 seconds)
## Iteration 750: error is 0.574989 (50 iterations in 0.28 seconds)
## Iteration 800: error is 0.574091 (50 iterations in 0.28 seconds)
## Iteration 850: error is 0.572351 (50 iterations in 0.28 seconds)
## Iteration 900: error is 0.571189 (50 iterations in 0.28 seconds)
## Iteration 950: error is 0.569621 (50 iterations in 0.28 seconds)
## Iteration 1000: error is 0.568153 (50 iterations in 0.28 seconds)
## Fitting performed in 5.76 seconds.

df = as.data.frame(tsne.dim$Y)
df$NOME_PARLAMENTAR = emendas.area.2$NOME_PARLAMENTAR

ggplot(df, aes(x = V1, y = V2, label = NOME_PARLAMENTAR)) + 
  geom_point(alpha = 0.8, size = 3, color = "tomato") 

ggplot(df, aes(x = V1, y = V2, label = NOME_PARLAMENTAR)) + 
  geom_point(alpha = 0.2, size = 3, color = "tomato") + 
  geom_text(alpha = .7, size = 3, hjust = -.2)

Utilizando a técnica t-SNE, conseguimos identificar 4 grupos maiores, porém não é possível distinguir qual a relação entre os tipos de gasto e os grupos, iremos optar pelo PSA para continuar nossa análise.

Na atividade passada, propusemos 4 grupos utilizando a técnica kmeans e fizemos as seguintes anotações:

• O grupo 1 se destaca em investir um pouco mais que os outros em Organização Agrária.
• O grupo 2 se destaca em não investir em Saneamento, Urbanismo, Agricultura e Assistência Social.
• O grupo 3 se destaca em não investir em Cultura, Comércio e Serviços.
• O grupo 4 se destaca em investir em Ciência e tecnologia, Gestão Ambiental e Indústria.

Vamos repetir o plot gerado acima para facilitar a análise:

autoplot(principal.components, shape = TRUE, 
         loadings = TRUE, loadings.colour = 'blue',
         loadings.label = TRUE, loadings.label.size = 4)

Podemos notar o seguinte:

• O grupo 4 se encontra na parte superior do gráfico
• O grupo 3 poderia ser o grupo que tem maiores valores de defesa nacional, visto que cultura e comécios e serviços tem os vetores com mesma direção e sentidos contrários, ou pelo menos perto.
• O grupo 2 poderia ser descrito pelos que estão próximos do centro dos vetores, visto que não investem em saneamento, urbanismo, agricultura e assistência social.
• O grupo 1 pode ser o que tem maior valor de organização agrária, sendo os localizados mais abaixo e a direita.

Como reduzimos as dimensões de 17 para 2, perdemos bastante variabilidade nos dados, mas mesmo assim conseguimos ver uma boa relação entre os grupos e variáveis descritas acima.

Se houvesse uma menor perda de variabilidade dos dados com a redução de dimensões, também seríamos capaz de afirmar que existe uma relação entre algumas variáveis, tais como Gestão Ambiental, Indústria e Ciência e Tecnologia, mas, como vimos acima, a perda foi considerável, logo, nada podemos afirmar sobre este assunto.

No final, apesar de toda a perda de variabilidade, podemos concluir que a redução de dimensionalidade foi satisfatória, visto a relação dos vetores e as anotações feitas a partir do kmeans no checkpoint passado.